-- card: 18515 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: DeleteResFork
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XCMD,DeleteResFork,it
end Install


-- part 3 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=64 top=300 right=322 bottom=202
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: DeleteResFork
----- HyperTalk script -----
on mouseUp
  -- This button uses the DeleteResFork XCMD to delete the
  -- resource fork of a stack.
  deleteresfork
  get the result
  if it is not empty then put it
end mouseUp



-- part 4 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 6 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part contents for background part 16
----- text -----
DELETERESFORK XCMD version 1.6
Kevin Calhoun

DeleteResFork deletes the resource fork of a stack while leaving the data fork intact.

Each Macintosh file, including HyperCard stacks, has two forks--a resource fork and a data fork, either of which may be empty.  HyperCard stores all the information about buttons, fields, text, and pictures in the data fork of your stacks.  XCMD's, XFCN's, PICT's, and other resources are stored in the resource fork.

DeleteResFork is for that trying moment when you discover that the resource fork of a stack has been ruined.  If this should occur, all of the data HyperCard relies on will still be intact--it's stored in the data fork--but you'll need to jettison your garbled resource fork and then re-install the necessary resources.

How can you tell if the resource fork has been ruined?  If ResEdit tells you that there was an error while opening the stack or if a disk utility tells you that the resource fork still takes up disk space even though HyperCard can't find the resources, then you know that your resource fork has been compromised.  (Sometimes HyperCard can't find newly copied resources until you close the stack and then reopen it.  Don't panic until after you've tried this.)

DeleteResFork won't let you regain access to a ruined resource fork.  Instead, it just gets rid of it.  It lets you "shake loose" a worthless resource fork that can't be read and start afresh.

NOTE:  It's unwise to delete the resource fork of a stack that is already open.  Make a copy of the stack and then work on the copy.

INVOKING DELETERESFORK

DeleteResFork <"fileName">

DeleteResFork takes one optional parameter, the full pathname of the file whose resource fork you want to delete.  If the file name is not supplied, a standard file dialog box appears, from which you can select a stack.

If the file name supplied is not the full pathname of an extant stack, or if there is any other error, DeleteResFork will return an error message as the Result.  The first word of this message will be "Error."

NOTE FOR ADVANCED PROGRAMMERS:
Because XCMD's have no "owned resources" and because there's no official "XCMD Mover," you can never count on resources such as DITL's or STR#'s being around when you need them.  The PrintField XCMD checks for the presence of the proper resources for its dialog.  If they're there it displays its dialog; otherwise it goes ahead and prints without the dialog.  With DeleteResFork, I took a different approach--it creates a dialog without using a DITL resource for the dialog item list.

The functions AddButton, AddUserItem, and AddStatText append a new item to a dialog item list in memory.  The function MakeDITL uses these to build an item list from scratch.
(Roger tells me that Tech Note #95, How To Add Items to the Print Dialogs, includes some code that handles the general case of adding an item to an item list.)

The drawback to creating a dialog item list on the fly without resources is that you can't alter the text of the dialog without recompiling the source code.  However, in the case of XCMD's it may be more valuable to be certain that a vital resource isn't missing than it is to enable alteration of titles and text without source code.

Perhaps the safest procedure is to include both the resources and the code to create them on the fly.  If the resources are present, go ahead and use them.  If not, create them on the fly.

DeleteResFork also contains a filter for ModalDialog that handles the usual keyboard equivalents for Cancel (command-period, command-q, command-Q, escape) and OK (return and enter).

Revision History:
8 June 1989, Version 1.6 -- Fixed double disposal of item list handle.

-- part contents for card part 4
----- text -----
UNIT DataSaver;

{ DeleteResFork XCMD © 1988-1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
Pascal DeleteResFork.p
Link -m ENTRYPOINT ∂
     -o "YourFile" ∂
     -rt XCMD=1659 ∂
     -sn Main=DeleteResFork ∂
     DeleteResFork.p.o ∂
    "{Libraries}"interface.o ∂
    "{PLibraries}"Paslib.o ∂
    "{Libraries}"HyperXLib.o
*)

{$R-}

INTERFACE
  USES
    Types,
    Memory,
    QuickDraw,
    Fonts,
    Dialogs,
    Files,
    Resources,
    Packages,
    OSEvents,
    ToolUtils,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);

IMPLEMENTATION

  TYPE
{ for creating dialog items }
    dItemPtr = ^dialogItem;
    dItemHndl = ^dItemPtr;
    dialogItem = RECORD
        placeholder : handle;
        displayRect : Rect;
        typeAndDataLength : INTEGER;
      END;

  PROCEDURE SaveTheData (paramPtr : XCMDPtr); FORWARD;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  BEGIN
    SaveTheData(paramPtr);
  END;

  FUNCTION GetScreenBitsBounds: Rect;
  { get screenbits.bounds from the QuickDraw globals }
  TYPE
    LongwordPtr = ^LONGINT;
    BitMapPtr = ^BitMap;
  CONST
    screenBitsOffset = -122;
    CurrentA5 = $904;
  VAR
    screenBitsPtr : BitMapPtr;
    myLongwordPtr : LongwordPtr;
  BEGIN
    myLongwordPtr := LongwordPtr(CurrentA5);
      { myLongwordPtr now points to the pointer to the first QD global }
    myLongwordPtr := LongwordPtr(myLongwordPtr^);
      { myLongwordPtr now points to the first QD global }
    screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset);
      { screenBitsPtr now points to the screenBits BitMap }
    GetScreenBitsBounds := screenBitsPtr^.bounds;
  END;

  PROCEDURE GetEventMask (VAR theMask : INTEGER);
{ returns the current event mask in theMask }
    CONST
      SysEvtMask = $144;
    TYPE
      IntegerPtr = ^INTEGER;
    VAR
      myIntPtr : IntegerPtr;
  BEGIN
    myIntPtr := IntegerPtr(SysEvtMask);
    theMask := myIntPtr^;
  END;

  PROCEDURE CenterRect(VAR r: Rect; inRect: Rect);
    VAR
      hSize, vSize: INTEGER;
      hCoord, vCoord: INTEGER;
  BEGIN
    WITH r DO
      BEGIN
      hCoord := left;
      vCoord := top;
      hSize := right-left;
      vSize := bottom-top;
      END;
    WITH inRect DO
      BEGIN
      hCoord := (right-left - hSize) DIV 2 + left;
      vCoord := (bottom-top - vSize) DIV 2 + top;
      END;
    SetRect(r, hCoord, vCoord, hCoord+hSize, vCoord+vSize);
  END;

  PROCEDURE PassReturnValue (paramPtr : XCMDPtr;
                  theMsg : Str255); { set theResult }
  BEGIN
    paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
  END;

  FUNCTION MyFilter (theDialog : DialogPtr;
                  VAR theEvent : EventRecord;
                  VAR itemHit : INTEGER) : BOOLEAN;
{ filter function for modal dialog -- handles the usual key equivalents for OK and Cancel }
    VAR
      theChar : char;
      dummy : EventRecord;

    PROCEDURE PushButton (itemNo : INTEGER);
{ Hilites the button itemNo while a key is pressed. }
{ For this to work properly, the event mask must be set to allow }
{ keyUp events to be detected -- that's why the call to ModalDialog, }
{ below, is bracketed by calls to SetEventMask. }
      VAR
        itemType : INTEGER;
        itemHandle : Handle;
        itemBox : Rect;
    BEGIN
      GetDItem(theDialog, itemNo, itemType, itemHandle, itemBox);
      HiliteControl(ControlHandle(itemHandle), inButton);
      REPEAT
      UNTIL OSEventAvail(keyUpMask, dummy);
      HiliteControl(ControlHandle(itemHandle), 0);
    END;

  BEGIN
    MyFilter := FALSE;
    CASE theEvent.what OF
      keyDown, autoKey : 
        BEGIN
          theChar := CHR(BitAnd(theEvent.message, charCodeMask));
          IF BitAnd(theEvent.modifiers, cmdKey) <> 0 THEN
            BEGIN
              MyFilter := TRUE;
              CASE ORD(theChar) OF
                46, 81, 113 :
{ if user pressed command-period, -q, or -Q, then do Cancel }
                  BEGIN
                    PushButton(Cancel);
                    itemHit := Cancel;
                    MyFilter := TRUE;
                  END;
              END;
            END
          ELSE
            CASE ORD(theChar) OF
              13, 3 :
{ if the user pressed return or enter, do OK }
                BEGIN
                  PushButton(OK);
                  itemHit := OK;
                  MyFilter := TRUE;
                END;
              27, 96 :
{ if user pressed the escape key or the tilde key, do Cancel }
                BEGIN
                  PushButton(Cancel);
                  itemHit := Cancel;
                  MyFilter := TRUE;
                END;
            END;
        END;
    END;
  END;

  PROCEDURE DrawBoxAroundDefault (theWindow : WindowPtr;
                  itemNo : INTEGER);
    VAR
      itemType : integer;
      itemHdl : Handle;
      itemBox : rect;
  BEGIN
    GetDItem(theWindow, 1, itemType, itemHdl, itemBox);
    PenSize(3, 3);
    InsetRect(itemBox, -4, -4);
    FrameRoundRect(itemBox, 16, 16);
    PenSize(1, 1);
  END;

  PROCEDURE DrawVersionInfo (theWindow : WindowPtr;
                  itemNo : INTEGER);
    VAR
      itemType : integer;
      itemHdl : Handle;
      itemBox : rect;
      str : Str255;
  BEGIN
    str := 'DeleteResFork XCMD 1.6   ©1989 Dartmouth College';
    GetDItem(theWindow, itemNo, itemType, itemHdl, itemBox);
    TextFont(Geneva);
    TextSize(9);
    TextBox(POINTER(ORD(@str) + 1), LENGTH(str), itemBox, teJustLeft);
    TextFont(SystemFont);
    TextSize(12);
  END;

  FUNCTION AddButton (boundsRect : rect;
                  title : Str255;
                  VAR theItems : Handle) : OSErr;
{ add information for a new button item to the end of the DITL theItems }
    VAR
      newItem : DItemHndl;
      err : OSErr;
  BEGIN
    newItem := DItemHndl(NewHandle(SIZEOF(DialogItem)));
    err := MemError;
    IF (newItem <> NIL) AND (err = noErr) THEN
      BEGIN
        MoveHHi(Handle(newItem));
        HLock(Handle(newItem));
        WITH newItem^^ DO
          BEGIN
            placeholder := NIL;
            displayRect := boundsRect;  { display rectangle }
            typeAndDataLength := (ctrlItem + btnCtrl) * 256 + LENGTH(title);
                     { high byte contains itemType, low byte contains length of the button title }
          END;
        err := HandAndHand(Handle(newItem), theItems);  { copy this info into item list }
        IF err = noErr THEN
          err := PtrAndHand(POINTER(ORD4(@title) + 1), theItems, LENGTH(title));
               { copy the characters of the title into the item list }
        DisposHandle(Handle(newItem));
      END;
    AddButton := err;
  END;

  FUNCTION AddUserItem (boundsRect : rect;
                  theProc : ProcPtr;
                  VAR theItems : Handle) : OSErr;
    VAR
      theUserItem : DItemHndl;
      err : OSErr;
  BEGIN
    theUserItem := DItemHndl(NewHandle(SIZEOF(DialogItem)));
    err := MemError;
    IF (theUserItem <> NIL) AND (err = noErr) THEN
      BEGIN
        MoveHHi(Handle(theUserItem));
        HLock(Handle(theUserItem));
        WITH theUserItem^^ DO
          BEGIN
            placeholder := Handle(theProc);
            displayRect := boundsRect;
            typeAndDataLength := userItem * 256 + 0;
          END;
        err := HandAndHand(Handle(theUserItem), theItems);
        DisposHandle(Handle(theUserItem));
      END;
    AddUserItem := err;
  END;

  FUNCTION AddStatText (boundsRect : rect;
                  str : Str255;
                  VAR theItems : Handle) : OSErr;
    VAR
      theStatTextItem : DItemHndl;
      err : OSErr;
  BEGIN
    theStatTextItem := DItemHndl(NewHandle(SIZEOF(DialogItem)));
    err := MemError;
    IF (theStatTextItem <> NIL) AND (err = noErr) THEN
      BEGIN
        MoveHHi(Handle(theStatTextItem));
        HLock(Handle(theStatTextItem));
        WITH theStatTextItem^^ DO
          BEGIN
            placeholder := NIL;
            displayRect := boundsRect;
            typeAndDataLength := (statText + itemDisable) * 256 + LENGTH(str);
          END;
        err := HandAndHand(Handle(theStatTextItem), theItems);
        IF err = noErr THEN
          err := PtrAndHand(POINTER(ORD4(@str) + 1), theItems, LENGTH(str));
        DisposHandle(Handle(theStatTextItem));
      END;
    AddStatText := err;
  END;

  FUNCTION MakeDITL (VAR theItems : Handle) : OSErr;
{ Create our dialog item list on the fly. }
{ We rely heavily on the information given in IM-I, p. 427 }
    CONST
      numItems = 6;
    VAR
      myStatTextItem : dItemHndl;
      err : OSErr;
      itemCount : INTEGER;
      str : Str255;
      theRect : Rect;
  BEGIN
    theItems := NewHandle(2);
{ we'll build this handle into a full item list by appending info to it }
{ for each item we want to add with HandAndHand and PtrAndHand }
    IF theItems <> NIL THEN
      BEGIN
        itemCount := numItems - 1;
        BlockMove(@itemCount, theItems^, 2);
{ first two bytes of the DITL = number of items in list minus 1 }
        SetRect(theRect, 230, 100, 300, 120);
        err := AddButton(theRect, 'OK', theItems);
        IF err = noErr THEN
          BEGIN
            SetRect(theRect, 140, 100, 210, 120);
            err := AddButton(theRect, 'Cancel', theItems);
            IF err = noErr THEN
              BEGIN
                SetRect(theRect, 220, 90, 310, 130);
                err := AddUserItem(theRect, @DrawBoxAroundDefault, theItems);
                IF err = noErr THEN
                  BEGIN
                    SetRect(theRect, 10, 97, 130, 125);
                    err := AddUserItem(theRect, @DrawVersionInfo, theItems);
                    IF err = noErr THEN
                      BEGIN
                        SetRect(theRect, 10, 10, 302, 50);
                        str := 'Are you sure you want to delete the resource fork of: ';
                        err := AddStatText(theRect, str, theItems);
                        IF err = noErr THEN
                          BEGIN
                            SetRect(theRect, 10, 52, 302, 92);
                            str := '“^0”? ';
                            err := AddStatText(theRect, str, theItems);
                          END;  { if err = noErr when creating the first statText item }
                      END;  { if err = noErr when creating the version info userItem }
                  END;  { if err = noErr when creating the default button userItem }
              END;  { if err = noErr when creating Cancel Button }
          END;  { if err = noErr when creating OK button }
      END; { if theItems <> nil }
    MakeDITL := err;
  END;

  PROCEDURE DoSFGet (VAR SFGetReply : SFReply);
    VAR
      where : point;
      typeList : SFTypeList;
      dlgt: DialogTHndl;
      r: rect;
      screen: rect;
      h, v: INTEGER;
  BEGIN  { select text file to read using SFGetFile }
    dlgt := DialogTHndl(GetResource('DLOG',getDlgID));
    if dlgt <> nil then
      begin
      r := dlgt^^.boundsRect;
      screen := GetScreenBitsBounds;
      h := ((screen.right - screen.left) - (r.right - r.left)) div 2;
      v := ((screen.bottom - screen.top) - (r.bottom - r.top)) div 2;
      SetPt(where, h, v);
      end
    else SetPt(where, 82, 75);
    typeList[0] := 'STAK';                { tell SFGetFile to display only text files }
    SFGetFile(where, '', NIL, 1, typeList, NIL, SFGetReply);          { call SFGetFile }
  END;

  FUNCTION DeleteResourceFork (fName : Str255;
                  vRefNum : INTEGER) : OSErr;
{ delete the resource fork of a file }
    VAR
      theRefNum : INTEGER;
      closeErr, err : OSErr;
  BEGIN
    err := OpenRF(fName, vRefNum, theRefNum);  { open the file }

    IF err = noErr THEN              { continue only if file could be opened }
      BEGIN
        err := SetEOF(theRefNum, 0);  { set the length of the resource fork to 0 }
        closeErr := FSClose(theRefNum);  { close the file }
      END;
    DeleteResourceFork := err;
  END; { procedure DeleteResourceFork }

  PROCEDURE SaveTheData (paramPtr : XCMDPtr);
    VAR
      err : OSErr;
      SFGetReply : SFReply;
      gotAFile : BOOLEAN;
      theFileName : Str255;
      theVRefNum : INTEGER;
      fndrInfo : FInfo;
      myItems : Handle;
      bounds : rect;
      myDialog : DialogPtr;
      dStorage : Handle;
      theMask : INTEGER;
      itemHit : INTEGER;
      numStr : Str255;

  BEGIN { procedure SaveTheData }
    gotAFile := FALSE;
    IF paramPtr^.paramCount < 1 THEN
{ user did not specify a file -- put up standard file dialog box }
      BEGIN
        DoSFGet(SFGetReply);
        SendCardMessage(paramPtr, 'go to this card');
        IF SFGetReply.good THEN
          BEGIN         { continue only if user actually selected a file }
            WITH SFGetReply DO
              BEGIN
                theFileName := fName;
                theVRefNum := vRefNum;
              END;  { with SFGetReply }
            gotAFile := TRUE;
          END;
      END
    ELSE
{ user specified a file -- check to see if it's really a stack }
      BEGIN
        ZeroToPas(paramPtr, paramPtr^.params[1]^, theFileName);
        err := GetFInfo(theFileName, 0, fndrInfo);
        IF (err = noErr) AND (fndrInfo.fdType = 'STAK') THEN
          BEGIN
            gotAFile := TRUE;
            theVRefNum := 0;
          END
        ELSE IF err <> noErr THEN
          BEGIN
          NumToStr(paramPtr, err, numStr);
          PassReturnValue(paramPtr, CONCAT('Error ', numStr));
          END
        ELSE
          PassReturnValue(paramPtr, 'Error -- that file is not a stack');
      END;
    IF gotAFile THEN
      BEGIN
{ create our dialog item list on the fly and put up our dialog }
        err := MakeDITL(myItems);
        IF err = noErr THEN
          BEGIN
          SetRect(bounds, 100, 80, 412, 210);
          CenterRect(bounds, GetScreenBitsBounds);
          ParamText(theFileName, '', '', '');
          dStorage := NewHandle(SIZEOF(DialogRecord));
          err := MemError;
          IF dStorage <> NIL THEN
            BEGIN
            MoveHHi(dStorage);
            HLock(dStorage);
            myDialog := NewDialog(dStorage^, bounds, '', TRUE, dBoxProc, POINTER(-1), FALSE, 0, myItems);
            IF myDialog <> NIL THEN
              BEGIN
              GetEventMask(theMask);
              SetEventMask(everyEvent);
              REPEAT
                ModalDialog(@MyFilter, itemHit);
              UNTIL (itemHit = OK) OR (itemHit = Cancel);
              SetEventMask(theMask);
              CloseDialog(myDialog);
              IF itemHit = OK THEN
                err := DeleteResourceFork(theFileName, theVRefNum);
              END;
            DisposHandle(dStorage);
            END;
          DisposHandle(myItems);
          END;
        IF err <> noErr THEN
          BEGIN
          NumToStr(paramPtr, err, numStr);
          PassReturnValue(paramPtr, CONCAT('Error ', numStr));
          END;
      END; { if gotAFile }
  END;

END.